home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / exec.pqs / exec.pas
Encoding:
Pascal/Delphi Source File  |  1985-07-07  |  7.0 KB  |  203 lines
  1. { EXEC.PAS version 1.3
  2.  
  3.   This file contains 2 functions for Turbo Pascal that allow you to run other
  4.   programs from within a Turbo program.  The first function, SubProcess,
  5.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  6.   second function, GetComSpec, returns the path name of the command
  7.   interpreter, which is necessary to do certain operations.  There is also a
  8.   main program that allows you to test the functions.
  9.  
  10.   Revision history
  11.   ----------------
  12.   Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up.
  13.   Version 1.2 had a subtle but dangerous bug: I set a variable that was
  14.               addressed relative to BP, using a destroyed BP!
  15.   Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features
  16.   Version 1.0 only worked with DOS 3.0 due to a subtle bug in DOS 2.x
  17.  
  18.     -  Bela Lubkin
  19.        Borland International Technical Support
  20.        CompuServe 71016,1573
  21. }
  22.  
  23. Type
  24.   Str66=String[66];
  25.   Str255=String[255];
  26.  
  27. Function SubProcess(CommandLine: Str255): Integer;
  28.   { Pass this function a string of the form
  29.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  30.  
  31.     For example,
  32.       'C:\SYSTEM\CHKDSK.COM'
  33.       'A:\WS.COM DOCUMENT.1'
  34.       'C:\DOS\LINK.EXE TEST;'
  35.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  36.  
  37.     The third example shows several things.  To do any of the following, you
  38.     must invoke the command processor and let it do the work: redirection;
  39.     piping; path searching; searching for the extension of a program (.COM,
  40.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  41.     command processor file is stored in the DOS environment.  The function
  42.     GetComSpec in this file returns the path name of the command processor.
  43.     Also note that you must use the /C parameter or COMMAND will not work
  44.     correctly.  You can also call COMMAND with no parameters.  This will allow
  45.     the user to use the DOS prompt to run anything (as long as there is enough
  46.     memory).  To get back to your program, he can type the command EXIT.
  47.  
  48.     Actual example:
  49.       I:=SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  50.  
  51.     The value returned is the result returned by DOS after the EXEC call.  The
  52.     most common values are:
  53.  
  54.        0: Success
  55.        1: Invalid function (should never happen with this routine)
  56.        2: File/path not found
  57.        8: Not enough memory to load program
  58.       10: Bad environment (greater than 32K)
  59.       11: Illegal .EXE file format
  60.  
  61.     If you get any other result, consult an MS-DOS Technical Reference manual.
  62.  
  63.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  64.     restrict the amount of free dynamic memory used by your program.  Only the
  65.     memory that is not used by the heap is available for use by other
  66.     programs. }
  67.  
  68.   Const
  69.     SSSave: Integer=0;
  70.     SPSave: Integer=0;
  71.  
  72.   Var
  73.     Regs: Record Case Integer Of
  74.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  75.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  76.           End;
  77.     FCB1,FCB2: Array [0..36] Of Byte;
  78.     PathName: Str66;
  79.     CommandTail: Str255;
  80.     ParmTable: Record
  81.                  EnvSeg: Integer;
  82.                  ComLin: ^Integer;
  83.                  FCB1Pr: ^Integer;
  84.                  FCB2Pr: ^Integer;
  85.                End;
  86.     I,RegsFlags: Integer;
  87.  
  88.   Begin
  89.     If Pos(' ',CommandLine)=0 Then
  90.      Begin
  91.       PathName:=CommandLine+#0;
  92.       CommandTail:=^M;
  93.      End
  94.     Else
  95.      Begin
  96.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  97.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  98.      End;
  99.     CommandTail[0]:=Pred(CommandTail[0]);
  100.     With Regs Do
  101.      Begin
  102.       FillChar(FCB1,Sizeof(FCB1),0);
  103.       AX:=$2901;
  104.       DS:=Seg(CommandTail[1]);
  105.       SI:=Ofs(CommandTail[1]);
  106.       ES:=Seg(FCB1);
  107.       DI:=Ofs(FCB1);
  108.       MsDos(Regs); { Create FCB 1 }
  109.       FillChar(FCB2,Sizeof(FCB2),0);
  110.       AX:=$2901;
  111.       ES:=Seg(FCB2);
  112.       DI:=Ofs(FCB2);
  113.       MsDos(Regs); { Create FCB 2 }
  114.       ES:=CSeg;
  115.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  116.       AH:=$4A;
  117.       MsDos(Regs); { Deallocate unused memory }
  118.       With ParmTable Do
  119.        Begin
  120.         EnvSeg:=MemW[CSeg:$002C];
  121.         ComLin:=Addr(CommandTail);
  122.         FCB1Pr:=Addr(FCB1);
  123.         FCB2Pr:=Addr(FCB2);
  124.        End;
  125.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  126.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  127.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  128.              $1E/$55/                 { Save <DS>, <BP>         }
  129.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  130.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  131.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  132.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  133.              $FA/                     { Disable interrupts      }
  134.              $CD/$21/                 { Call MS-DOS             }
  135.              $FA/                     { Disable interrupts      }
  136.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  137.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  138.              $FB/                     { Enable interrupts       }
  139.              $5D/$1F/                 { Restore <BP>,<DS>       }
  140.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  141.              $89/$86/ Regs );         { Regs.AX:=<AX>;          }
  142.       { The messing around with SS and SP is necessary because under DOS 2.x,
  143.         after returning from an EXEC call, ALL registers are destroyed except
  144.         CS and IP!  I wish I'd known that before I released this package the
  145.         first time... }
  146.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  147.       Else SubProcess:=0;
  148.      End;
  149.   End;
  150.  
  151. Function GetComSpec: Str66;
  152.   Type
  153.     Env=Array [0..32767] Of Char;
  154.   Var
  155.     EPtr: ^Env;
  156.     EStr: Str255;
  157.     Done: Boolean;
  158.     I: Integer;
  159.  
  160.   Begin
  161.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  162.     I:=0;
  163.     Done:=False;
  164.     EStr:='';
  165.     Repeat
  166.       If EPtr^[I]=#0 Then
  167.        Begin
  168.         If EPtr^[I+1]=#0 Then Done:=True;
  169.         If Copy(EStr,1,8)='COMSPEC=' Then
  170.          Begin
  171.           GetComSpec:=Copy(EStr,9,100);
  172.           Done:=True;
  173.          End;
  174.         EStr:='';
  175.        End
  176.       Else EStr:=EStr+EPtr^[I];
  177.       I:=I+1;
  178.     Until Done;
  179.   End;
  180.  
  181. { Example program.  Set both mInimum and mAximum free dynamic memory to 100
  182.   and compile this to a .COM file.  Delete the next line to enable: }
  183. (*
  184.  
  185. Var Command: Str255;
  186.     I: Integer;
  187.  
  188. Begin
  189.   WriteLn('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  190.   Repeat
  191.     Write('=->');
  192.     ReadLn(Command);
  193.     If Command='*' Then Halt;
  194.     If Command<>'' Then
  195.      Begin
  196.       If Command[1]='*' Then Command:=GetComSpec+' /C '+Copy(Command,2,255);
  197.       I:=SubProcess(Command);
  198.       If I<>0 Then WriteLn('Error - ',I);
  199.      End;
  200.   Until False;
  201. End.
  202. *)
  203.